home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 3: CDPD 3 / Almathera Ten on Ten - Disc 3: CDPD3.iso / scope / 001-025 / scopedisk21 / hamhaf / ham&haf < prev    next >
Encoding:
Text File  |  1995-03-18  |  3.8 KB  |  190 lines
  1.  
  2. WINDOW 1,,(20,20)-(600,60)
  3. COLOR 2,1:CLS
  4. PRINT 
  5. PRINT "    Howdy!"
  6.  
  7. ON ERROR GOTO NoBMAPS  
  8.   DECLARE FUNCTION AllocMem& LIBRARY
  9.   LIBRARY "exec.library"
  10.   LIBRARY "intuition.library"
  11. ON ERROR GOTO 0
  12.  
  13. GOSUB Help' <-- REM this to speed intro
  14. COLOR 0,1
  15. SCREEN 2,320,200,1,1 :REM *** just ONE Plane
  16. WINDOW 2,,,16,2
  17. PALETTE 0,0,0,0
  18. PALETTE 0,1,1,1
  19.  
  20. ON BREAK GOSUB Bye 
  21. BREAK ON
  22.  
  23. FOR I%=2 TO 6
  24.   CreateNewPlane
  25.   COLOR I%,1': LOCATE 1,1
  26.   PRINT "I now have";I%;"Planes"; 
  27.   FOR J%=1 TO I%:PRINT "!";:NEXT
  28.   PRINT 
  29. NEXT
  30.  
  31. COLOR 2: PRINT: PRINT
  32. PRINT "     Use left mouse button
  33. PRINT "          to draw.
  34. PRINT ,"OR 
  35. PRINT "     Click on a color below
  36. PRINT ,"OR
  37. PRINT "     Press F1 thru F6 or HELP
  38. PRINT :PRINT :PRINT ,,"JeC 788
  39.  
  40.  GOSUB Colors
  41.  HAM
  42.   Clr%=3:      XY%=MOUSE(0)
  43.   X%=MOUSE(1): Y%=MOUSE(2)
  44.  
  45. '***** MAIN LOOP *****
  46. WHILE 1
  47.   XY%=MOUSE(0): oX%=X%: oY%=Y%
  48.   X%=MOUSE(1): Y%=MOUSE(2)
  49.   IF XY% THEN
  50.     IF Y%<194 THEN
  51.       LINE(X%,Y%)-(oX%,oY%),Clr%
  52.     ELSE 
  53.       Clr%=ABS(POINT(X%,194))
  54.     END IF
  55.   END IF
  56.   K$=INKEY$: IF K$>"" THEN GOSUB Keys
  57. WEND  
  58. '***** END O'LOOP *****
  59.   
  60.   'COLOR 2: LOCATE 1,1:PRINT MOUSE(1);MOUSE(2);"    "
  61.  
  62. Keys:
  63.     Kasc=ASC(K$)
  64.     IF Kasc=129 OR Kasc=139 THEN GOSUB Help
  65.     IF Kasc=130 THEN CALL HAM
  66.     IF Kasc=131 THEN CALL HB
  67.     IF Kasc=132 THEN COLOR 1,0:CLS:GOSUB Colors
  68.     IF Kasc=133 THEN GOSUB Demo
  69.     IF Kasc=134 THEN GOSUB Bye
  70. RETURN  
  71.  
  72. Help:
  73.   RESTORE: WINDOW 1: COLOR 3,1:CLS
  74.   LOCATE 5,10:PRINT "Click here for next line";
  75.   LOCATE 2,1: COLOR 2
  76.   FOR I=1 TO 7
  77.     FOR J=2 TO 3
  78.       READ H$: LOCATE J,1:PRINT H$;SPACE$(60)
  79.     NEXT
  80.     GOSUB WayCheer
  81.   NEXT  
  82.   WINDOW 2
  83.  RETURN   
  84.  
  85. Colors:
  86. FOR I=0 TO 315 STEP 5
  87.   LINE(I,194)-STEP(5,6),I*.2,bf
  88. NEXT  
  89. RETURN
  90.    
  91. Demo:
  92. CALL HAM
  93. Hi=5: Hi2=4
  94.  
  95. FOR Green=0 TO 15
  96.   Blue=0: Red=0
  97.   LINE(0,Green*Hi)-STEP(0,Hi2),0
  98.   LINE(1,Green*Hi)-STEP(0,Hi2),Green+48
  99.   FOR X=0 TO 7
  100.     FOR Red=1 TO 15
  101.       LINE(X*32+Red+1,Green*Hi)-STEP(0,Hi2),Red+32
  102.     NEXT Red
  103.     Blue=Blue+1
  104.     LINE(X*32+17,Green*Hi)-STEP(0,Hi2),Blue+16
  105.     FOR Red=14 TO 0 STEP -1
  106.       LINE(X*32+17+15-Red,Green*Hi)-STEP(0,Hi2),Red+32
  107.     NEXT Red
  108.     Blue=Blue+1
  109.     IF Blue<16 THEN LINE(X*32+33,Green*Hi)-STEP(0,Hi2),Blue+16
  110.   NEXT X
  111. NEXT Green
  112. FOR I=0 TO 315 STEP 5
  113.  LINE(I*.9,I*.25+90)-STEP(5,12),I*.2,bf
  114.  LINE (300,I*.6)-(310,I*.6+3),I*.2,bf
  115. NEXT
  116.  
  117. RETURN
  118.  
  119. WayCheer:
  120.   MXY=MOUSE(0)
  121.   WHILE MOUSE(0)=0: SLEEP: WEND
  122.   WHILE MOUSE(0)<>0: SLEEP: WEND
  123.  RETURN
  124.  
  125. NoBMAPS:
  126.   PRINT "    I can't find the 
  127.   PRINT ,"Intuition.bmap
  128.   PRINT ,"     or
  129.   PRINT ,"Exec.bmap
  130.   PRINT ,"  Click here, then RUN again.";
  131.   GOSUB WayCheer
  132.   GOTO Bye
  133.   RESUME 0
  134.    
  135. Bye:
  136.  WINDOW 1
  137.  COLOR 2,1:CLS
  138.  PRINT 
  139.  PRINT,"Thanks for your support  
  140.  WINDOW CLOSE 2
  141.  SCREEN CLOSE 2
  142.  LIBRARY CLOSE
  143.  END
  144.  
  145. DATA " A very rudimentary HAM/Half-Bright drawing program."
  146. DATA " It uses the left mouse button and F1 thru F6"
  147.  
  148. DATA " F1 (or the `HELP' key) gets you here"
  149. DATA " F2 switches to HAM mode"
  150.  
  151. DATA " F3 switches to Half-Bright mode."
  152. DATA " F4 clears the screen"
  153.  
  154. DATA " F5 runs a demonstration of sorts.
  155. DATA " F6 Quits the program"
  156.  
  157. DATA " To select a color, click on one at the bottom of the screen."
  158. DATA " To draw press the left mouse button."
  159.  
  160. DATA " The HAM and Half-Bright routines are from"
  161. DATA "  `Amiga Tricks and Tips' by Abacus press"
  162.  
  163. DATA ""
  164. DATA "   Th...th...th...thats all, folks"
  165.  
  166. SUB CreateNewPlane STATIC
  167.   bitmap&=PEEKL(WINDOW(7)+46)+184
  168.   bitplane&=PEEKW(bitmap&)*PEEKW(bitmap&+2)
  169.   wdepth%=PEEK(bitmap&+5)
  170.   IF wdepth%>5 THEN EXIT SUB
  171.   newplane&=AllocMem&(bitplane&,65538&)
  172.   IF newplane&=0 THEN ERROR 7
  173.   POKEL bitmap&+8+wdepth%*4,newplane&
  174.   POKE bitmap&+5,wdepth%+1
  175.   IF wdepth%<5 THEN CALL RemakeDisplay
  176. END SUB
  177.  
  178. SUB HAM STATIC
  179.   ViewMode&=PEEKL(WINDOW(7)+46)+76
  180.   POKEW ViewMode&,2^11
  181.   CALL RemakeDisplay
  182. END SUB
  183.  
  184. SUB HB STATIC
  185.   ViewMode&=PEEKL(WINDOW(7)+46)+76
  186.   POKEW ViewMode&,2^7
  187.   CALL RemakeDisplay
  188. END SUB
  189.  
  190.